{-
  Eval.hs

  Copyright (c) 2008, Jin Nishikawa
-}
{-# define MODULE #-}
{-# INCLUDE "hsrb_eval.h" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Hsrb.Eval (rbEval, RbReturn(..)) where

import GHC.Ptr
import Foreign.C
import Foreign.Storable (peek)
import Foreign.Marshal.Alloc (malloc, free)
import Foreign.Marshal.Array (peekArray0)

foreign import ccall "rb_eval" c_rb_eval :: CString -> Ptr Int -> IO (Ptr a)

data RbReturn = RbNil
              | RbDouble Double
              | RbString String
              | RbInt Int
              | RbInteger Integer
              | RbBool Bool
              | RbArray [RbReturn]
              deriving (Eq, Show)

-- All supported type by hsrb.
t_nil    = 0x01
t_float  = 0x06
t_string = 0x07
t_fixnum = 0x0a
t_bignum = 0x0d
t_true   = 0x20
t_false  = 0x21

rbEval :: String -> IO RbReturn
rbEval str = do
    resetErrno
    type_p <- malloc
    ret <- rb_eval str type_p
    free type_p
    return ret

rb_eval str type_p = do
    val <- withCAString str (flip c_rb_eval type_p)
    err <- errno
    if err /= 0 then hsrb_error err
                else peek type_p >>= flip rb_ret val

rb_ret :: Int -> Ptr a -> IO RbReturn
rb_ret rb_type val
    | rb_type == t_nil    = return RbNil
    | rb_type == t_float  = castToDouble val >>= return . RbDouble
    | rb_type == t_string = castToString val >>= return . RbString
    | rb_type == t_fixnum = castToInt val >>= return . RbInt
    | rb_type == t_bignum = castToString val >>= return . RbInteger . (read :: String -> Integer)
    | rb_type == t_true   = return $ RbBool True
    | rb_type == t_false  = return $ RbBool False
    | otherwise = hsrb_error $ negate 1

castToString :: Ptr a -> IO String
castToString ptr = do
    ret <- peekCString $ castPtr ptr
    free ptr
    return ret

castToInt :: Ptr a -> IO Int
castToInt ptr = do
    ret <- peek $ castPtr ptr
    free ptr
    return ret

castToDouble :: Ptr a -> IO Double
castToDouble ptr = do
    ret <- peek $ castPtr ptr
    free ptr
    return ret

errno :: IO Int
errno = do
    (Errno err) <- getErrno
    return $ fromIntegral err

hsrb_error errno = error ("Hsrb Error: " ++ show errno)
